Gigarom 4/Mac Giga-ROM 4.0 - 1993.toast/FILES/DEV/I-Z/TransSkel.cpt/TransDisplay.pas

Pascal/Delphi Source File | 1987-02-09 | 26.4 KB | 1,024 lines | [TEXT/PJMM]

{    TransDisplay version 1.0 - TransSkel plug-in module supporting}
{    an arbitrary number of generic display windows with memory.}

{    TransSkel and TransDisplay are public domain, and are written by:}

{            Paul DuBois}
{            Wisconsin Regional Primate Research Center}
{            1220 Capital Court}
{            Madison WI  53706  USA}

{    UUCP:        [allegra,ihnp4,seismo]!uwvax !uwmacc !dubois }
{    ARPA :     dubois @ unix.macc.wisc.edu }
{                dubois @ rhesus.primate.wisc.edu }

{    The Pascal Version of TransSkel is public domain and was ported by        }

{            Owen Hartnett            }
{            Ωhm Software            }
{            163 Richard Drive        }
{            Tiverton, RI 02878        }

{    CSNET:    [e-mail]                                             }
{    ARPA:        [e-mail]                        }
{    UUCP:        [ihnp4,allegra]!brunix !omh                                            }

{    Psychic Wavelength:  182.2245 Meters  (sorry, couldn't resist)    }

{    This version of TransDisplay written for Lightspeed Pascal.  Lightspeed Pascal}
{    is a trademark of:}
{            THINK Technologies, Inc}
{            420 Bedford Street  Suite 350}
{            Lexington, MA  02173  USA}


 { History}
{  08/25/86    Genesis.  Beta version.}
{  09/15/86    Changed to allow arbitrary number of windows.  Changed}
{             version number to 1.0.}
{  01/10/87    Ported to LightSpeed Pascal by Owen Hartnett                }
{    Ωhm Software, 163 Richard Drive, Tiverton, RI 02878                }

UNIT TransDisplay;

INTERFACE

    USES
        TransSkelPas;

    PROCEDURE SetDWindow (theWind : WindowPtr);
    PROCEDURE DisplayString (theStr : str255);
    PROCEDURE DisplayHexLong (l : longint);
    PROCEDURE DisplayHexInt (i : integer);
    PROCEDURE DisplayHexChar (c : char);
    PROCEDURE DisplayBoolean (b : Boolean);
    PROCEDURE DisplayChar (c : char);
    PROCEDURE DisplayInt (i : integer);
    PROCEDURE DisplayLong (l : longint);
    PROCEDURE DisplayLn;
    PROCEDURE DisplayText (theText : Ptr;
                                    len : longint);
    FUNCTION GetNewDWindow (resourceNum : integer;
                                    behind : WindowPtr) : WindowPtr;
    FUNCTION NewDWindow (bounds : Rect;
                                    title : Str255;
                                    visible : Boolean;
                                    behind : WindowPtr;
                                    goAway : Boolean;
                                    refcon : longint) : WindowPTr;
    PROCEDURE FlushDWindow (theWind : WindowPtr;
                                    byteCount : longint);
    PROCEDURE GetDWindow (VAR theWind : WindowPtr);
    PROCEDURE SetDWindowFlush (theWind : WindowPtr;
                                    maxText, flushAmt : longint);
    PROCEDURE SetDWindowNotify (theWind : WindowPTr;
                                    p : ProcPtr);
    PROCEDURE setDWindowPos (theWind : WindowPtr;
                                    lineNum : integer);
    PROCEDURE SetDWindowStyle (theWind : WindowPtr;
                                    font, size, wrap, just : integer);
    FUNCTION GetDWindowTE (theWind : WindowPtr) : TEHandle;
    FUNCTION IsDWindow (theWind : WindowPtr) : Boolean;
    PROCEDURE TransDisplayInit;

IMPLEMENTATION

{    Display window types, constants, variables.}

    CONST
        monaco = 4;

    TYPE
        DIPtr = ^DisplayInfo;
        DIHandle = ^DIPtr;
        DisplayInfo = RECORD
                dWind : WindowPtr;        { display window         }
                dTE : TEHandle;            { window text            }
                dScroll : ControlHandle;    { window scroll bar      }
                dActivate : ProcPtr;        { notification procedure }
                dMaxText : longint;        { max text length        }
                dFlushAmt : longint;        { amount to autoflush    }
                dNext : DIHandle;            { next window structure  }
            END;


    VAR

{ Look at TransDisplayInit procedure for initial values of these variables    }

        d_font, d_size : integer;                    { default font              }
                                                { default pointsize         }
        d_wrap, d_just : integer;                { default word wrap (on)    }
                                                { default justification     }
        d_maxText, d_flushAmt : longint;        { default max text allowed  }
                                                { default autoflush amount  }
        d_activate : ProcPtr;                    { default notification proc }

{    Lowest allowable values for autoflush characteristics}


        d_loMaxText, d_loFlushAmt : longint;

        dwList : DIHandle;

{    Variables pertaining to the display window being operated on}
{    (updated, resized, etc.).  This window is not necessarily the}
{    same as curDispWind!  These variables are synced to the window}
{    with SyncGlobals. }

        dispInfo : DIHandle;        { info structure         }

        dispWind : WindowPtr;            { the window             }
        dispTE : TEHandle;                { window text            }
        dispScroll : ControlHandle;        { the scroll bar         }
        dActivate : ProcPtr;                { notification procedure }
        dMaxText, dFlushAmt : longint;        { max text allowed       }
        { amount to flush        }

{    curDispWind is the current output window.}
{    If curDispWind = nil, output is turned off.}

        curDispWind : WindowPtr;

{ -------------------------------------------------------------------- }
{                Miscellaneous Internal (private) Routines                }
{ -------------------------------------------------------------------- }



{    Draw grow box of dispWind in lower right hand corner}

    PROCEDURE DrawGrowBox;

        VAR
            oldClip : RgnHandle;
            r : Rect;

    BEGIN
        r := dispWind^.portRect;
        r.left := r.right - 15;        { draw only in corner }
        r.top := r.bottom - 15;
        oldClip := NewRgn;
        GetClip(oldClip);
        ClipRect(r);
        DrawGrowIcon(dispWind);
        SetClip(oldClip);
        DisposeRgn(oldClip);
    END;




{ -------------------------------------------------------------------- }
{            Lowest-level Internal (Private) Display Window Routines        }
{ -------------------------------------------------------------------- }

{    Get display window info associated with window.}
{    Return nil if window isn't a known display window.}

    FUNCTION GetDInfo (theWind : WindowPtr) : DIHandle;
        VAR
            h : DIHandle;
            foundit : Boolean;
    BEGIN
        h := dwList;
        foundit := false;
        WHILE (h <> NIL) AND NOT foundit DO
            BEGIN
                IF h^^.dWind = theWind THEN
                    BEGIN
                        GetDInfo := h;
                        h := NIL;
                        foundit := true;
                    END
                ELSE
                    h := h^^.dNext;
            END;
        IF NOT foundit THEN
            GetDInfo := NIL;                    {make it a nop    }
    END;

{    Synchronize globals to a display window.  theWind must be a legal}
{    display window, with one exception:  if theWind is nil, the}
{    variables are synced to the current port.  That is safe (and}
{    correct) because:}
{    (i)     nil is only passed by display window handler procedures,}
{         which are only called by TransSkel for display window}
{         events.}
{    (ii) TransSkel always sets the port to the window before}
{         calling the handler proc.}
{    Hence, use of the current port under these circumstances}
{    always produces a legal display window.}

{    SyncGlobals is not used in single display mode, because the}
{    globals are all set by SetupDWindow and do not change thereafter.}

    PROCEDURE SyncGlobals (theWind : WindowPtr);

        VAR
            dp : DIPtr;
    BEGIN
        IF theWind = NIL THEN                    { use current window }
            GetPort(theWind);
        dispWind := theWind;
        dispInfo := GetDInfo(dispWind);
        dp := dispInfo^;
        dispScroll := dp^.dScroll;
        dispTE := dp^.dTE;
        dActivate := dp^.dActivate;
        dMaxText := dp^.dMaxText;
        dFlushAmt := dp^.dFlushAmt;
    END;

{    Calculate the dimensions of the editing rectangle for}
{    dispWind (which must be set properly and is assumed to }
{    the current port).  (The viewRect and destRect are the}
{    same size .) Assumes the port , text font and text size are all}
{    set properly.  The viewRect is sized so that an integral}
{    number of lines can be displayed in it, i.e., so that a}
{    partial line never shows at the bottom. }

    PROCEDURE CalcEditRect (VAR r : Rect);

        VAR
            f : FontInfo;
            lineHeight : integer;

    BEGIN
        GetFontInfo(f);
        lineHeight := f.ascent + f.descent + f.leading;
        r := dispWind^.portRect;
        r.left := r.left + 4;
        r.right := r.right - 17;            { leave room for scroll bar + 2 }
        r.top := r.top + 2;
        r.bottom := r.top + ((r.bottom - (r.top - 2)) DIV lineHeight) * lineHeight;
    END;

{    Calculate the dimensions of the scroll bar rectangle for the}
{    window.  Make sure that the edges overlap the window frame and}
{    the grow box.}

    PROCEDURE CalcScrollRect (VAR r : Rect);

    BEGIN
        r := dispWind^.portRect;
        r.right := r.right + 1;
        r.left := r.right - 16;
        r.top := r.top - 1;
        r.bottom := r.bottom - 14;
    END;

{    Calculate the number of lines currently scrolled off}
{    the top.}

    FUNCTION LinesOffTop : integer;

        VAR
            ePtr : TEPtr;

    BEGIN
        ePtr := dispTE^;
        LinesOffTop := (ePtr^.viewRect.top - ePtr^.destRect.top) DIV ePtr^.lineHeight;
    END;

{    Highlight the scroll bar properly.  This means that it's not}
{    made active if the window itself isn't active, even if}
{    there's enough text to fill the window. }

    PROCEDURE HiliteScroll;
        VAR
            result : integer;
    BEGIN
        IF (GetCtlMax(dispScroll) > 0) AND (dispWind = FrontWindow) THEN
            result := 0
        ELSE
            result := 255;
        HiliteControl(dispScroll, result);
    END;

{    Scroll to the correct position.  lDelta is the}
{    amount to CHANGE the current scroll setting by.}
{    Positive scrolls the text up, negative down.}

    PROCEDURE ScrollText (lDelta : integer);

        VAR
            lHeight, newLine, topLine : integer;

    BEGIN
        lHeight := dispTE^^.lineHeight;
        topLine := LinesOffTop;
        newLine := topLine + lDelta;
        IF newLine < 0 THEN
            newLine := 0;
        IF newLine > GetCtlmax(dispScroll) THEN
            newLine := GetCtlMax(dispScroll);
        SetCtlValue(dispScroll, newLine);
        TEScroll(0, (topLine - newLine) * lHeight, dispTE);
    END;


{    Filter proc for tracking mousedown in scroll bar . The code}
{    for the part originally hit is stored in the control 's reference}
{    value by Mouse ( ) before calling this . }


{    Scroll by one line if the mouse is in an arrow.  Scroll by a half}
{    window's worth of lines if the mouse is in a page region. }

    PROCEDURE TrackScroll (theScroll : ControlHandle;
                                    partCode : integer);

        VAR
            lDelta, halfPage : integer;

    BEGIN
        IF partCode = GetCRefCon(theScroll) THEN        { still in same part? }
            BEGIN
                halfPage := ((dispTE^^.viewRect.bottom - dispTE^^.viewRect.top) DIV dispTE^^.lineHeight) DIV 2;
                IF halfPage = 0 THEN
                    halfPage := halfPage + 1;
                CASE partCode OF
                    inUpButton :
                        lDelta := -1;
                    inDownButton :
                        lDelta := 1;
                    inPageUp :
                        lDelta := -halfPage;
                    inPageDown :
                        lDelta := halfPage;
                    OTHERWISE
                END;
                ScrollText(lDelta);
            END;
    END;

{    Adjust the text in the text record and the scroll bar.  This is}
{    called for major catastrophes, such as resizing the window, or}
{    changing the word wrap style.  It makes sure the view and}
{    destination rectangles are sized properly, and that the bottom}
{    line of text never scrolls up past the bottom line of the}
{    window, if there's enough to fill the window, and that the}
{    scroll bar max and current values are set properly.}

{    Resizing the dest rect just means resetting the right edge}
{    (the top is NOT reset), since text might be scrolled off the}
{    top (i.e., destRect.top != 0).}

    PROCEDURE OverhaulDisplay;

        VAR
            r : Rect;
            nLines, visLines, topLines, scrollLines, lHeight : integer;
            { number of lines in TERec }
        { number of lines displayable in window }
        { number of lines currently scrolled off top }
        { number of lines to scroll down }

    BEGIN
        CalcEditRect(r);
        dispTE^^.destRect.right := r.right;
        dispTE^^.viewRect := r;
        TECalText(dispTE);        { recalc line starts }
        lHeight := dispTE^^.lineHeight;
        nLines := dispTE^^.nLines;
        visLines := (r.bottom - r.top) DIV lheight;
        topLines := LinesoffTop;

{    If the text doesn't fill the window (visLines > nLines - topLines),}
{    pull the text down if possible (if topLines > 0).  Make sure}
{    not to try to scroll down by more lines than are hidden off the top .}

        scrollLines := visLines - (nLines - topLines);
        IF (scrollLines > 0) AND (topLines > 0) THEN
            BEGIN
                IF scrollLines > topLines THEN
                    scrollLines := topLines;
                TEScroll(0, scrollLInes * lHeight, dispTE);
                toplines := topLines - scrollLines;
            END;
        TEUpdate(r, dispTE);
        IF nLines - visLines < 0 THEN
            SetCtlMax(dispScroll, 0)
        ELSE
            SetCtlMax(dispScroll, nLines - VisLines);
        SetCtlValue(dispScroll, topLines);
        HiliteScroll;
    END;

    PROCEDURE callpnoarg (myProc : ProcPtr);

{ For all the Procedures that are called with no arguments                            }

    INLINE
        $205f,     {movea.l  (a7)+,a0        ; (a0) is a ptr to string, 4(a0) is mode}
        $4e90;

    PROCEDURE callpBoolean (myBool : Boolean;
                                    myProc : ProcPtr);

{ Two calls use Booleans as one parameter arguments.  This procedure handles    }
{ both of them.                                                                            }

    INLINE
        $205f,     {movea.l  (a7)+,a0        ; (a0) is a ptr to string, 4(a0) is mode}
        $4e90;

{ ---------------------------------------------------------------- }
{                        Window Handler Routines                        }
{ ---------------------------------------------------------------- }



{    When the window comes active, highlight the scroll bar appropriately.}
{    When the window is deactivated, un-highlight the scroll bar.}
{    Redraw the grow box.}

{    Notify the host as appropriate.}

{    Note that clicking close box hides the window, which generates a}
{    deactivate event, so there is no need for a close notifier.}


    PROCEDURE Activate (isActive : Boolean);

    BEGIN
        SyncGlobals(NIL);                { sync to current port }
        DrawGrowBox;
        HiliteScroll;

        IF dActivate <> NIL THEN
            callpBoolean(isActive, dActivate);
    END;

{    Update window.  The update event might be in response to a}
{    window resizing.  If so, move and resize the scroll bar,}
{    and recalculate the text display.}

{    The ValidRect call is done because the HideControl adds the}
{    control bounds box to the update region - which would generate}
{    another update event!  Since everything is redrawn below anyway,}
{    the ValidRect is used to cancel the update.}

    PROCEDURE Update (resized : Boolean);

        VAR
            r : Rect;

    BEGIN
        SyncGlobals(NIL);                    { sync to current port }
        r := dispWind^.portRect;
        EraseRect(r);
        IF resized THEN
            BEGIN
                HideControl(dispScroll);
                r := dispScroll^^.contrlRect;
                ValidRect(r);
                CalcScrollRect(r);
                SizeControl(dispScroll, 16, r.bottom - r.top);
                MoveControl(dispScroll, r.left, r.top);
                OverHaulDisplay;
                ShowControl(dispScroll);
            END
        ELSE
            BEGIN
                r := dispTE^^.viewRect;
                TEUpdate(r, dispTE);
            END;
        DrawGrowBox;
        DrawControls(dispWind);    { redraw scroll bar }
    END;

{    Handle mouse clicks in window}

    PROCEDURE Mouse (thePt : Point;
                                    t : longint;
                                    mods : integer);

        VAR
            thePart : integer;
            oldCtlValue : integer;

    BEGIN
        SyncGlobals(NIL);                    { Sync to current port    }
        thePart := TestControl(dispScroll, thePt);
        IF thePart = inThumb THEN
            BEGIN
                OldCtlValue := GetCtlValue(dispScroll);
                IF TrackControl(dispScroll, thePt, NIL) = inThumb THEN
                    ScrollText(GetCtlValue(dispScroll) - oldCtlValue);
            END
        ELSE IF thePart <> 0 THEN
            BEGIN
                SetCRefCon(dispScroll, longint(thePart));
                oldCtlValue := TrackControl(dispScroll, thePt, @TrackScroll);
            END;
    END;

{    Remove the display window from the list, and dispose of it.}
{    Since the clobber procedure is never called except for real display}
{    windows, and since the list must therefore be non-empty, it is}
{    not necessary to check the legality of the window or that the}
{    window's in the list.}

{    Must do SetDWindow (nil) to turn output off, if the window being}
{    clobbered is the current output window.}

    PROCEDURE Clobber;

        VAR
            h, h2 : DIHandle;
            keepgoing : Boolean;

    BEGIN
        SyncGlobals(NIL);                    { sync to current port }
        IF dispWind = curDispWind THEN    { is it the first window in list? }
            SetDWindow(NIL);
        IF dwList^^.dWind = dispWind THEN    { found it }
            BEGIN
                h2 := dwList;
                dwList := dwList^^.dNext;
            END
        ELSE
            BEGIN
                h := dwList;
                keepgoing := true;
                WHILE (h <> NIL) AND keepgoing DO
                    BEGIN
                        h2 := h^^.dNext;
                        IF h2^^.dWind = dispWind THEN
                            BEGIN
                                h^^.dNext := h2^^.dNext;
                                keepgoing := false;
                            END;
                        h := h2;
                    END;
            END;
        DisposHandle(Handle(h2));        { get rid of information structure }
        TEDispose(dispTE);                { toss text record }
        DisposeWindow(dispWind);        { toss window and scroll bar }
        dispWind := NIL;
    END;

{ ---------------------------------------------------------------- }
{                            Control Routines                        }
{ ---------------------------------------------------------------- }


{    Test whether a window is a legal display window or not }

    FUNCTION IsDWindow;

    BEGIN
        IsDWindow := GetDInfo(theWind) <> NIL;
    END;

{    Return handle to display window's text record}

    FUNCTION GetDWindowTE;

        VAR
            dInfo : DIHandle;

    BEGIN
        IF GetDInfo(theWind) = NIL THEN
            GetDWindowTE := NIL
        ELSE
            GetDWIndowTE := dInfo^^.dTE;
    END;

{    Change the text display characteristics of a display window}
{    and redisplay it.  As a side effect, this always scrolls to the}
{    home position.}

    PROCEDURE SetDWindowStyle;

        VAR
            savePort : GrafPtr;
            f : FontInfo;
            te : TEHandle;
            r : Rect;

    BEGIN
        IF theWind = NIL THEN            { reset window creation defaults }
            BEGIN
                d_font := font;
                d_size := size;
                d_wrap := wrap;
                d_just := just;
            END
        ELSE
            BEGIN
                IF IsDWindow(theWind) THEN
                    BEGIN
                        GetPort(savePort);
                        SyncGlobals(theWind);
                        SetPort(dispWind);
                        te := dispTE;
                        r := te^^.viewRect;
                        EraseRect(r);
                        r := te^^.destRect;    { scroll home without redrawing }

                        OffsetRect(r, 0, 2 - r.top);
                        te^^.destRect := r;
                        te^^.crOnly := wrap;    { set word wrap }
                        TESetJust(just, te);    { set justification }
                        TextFont(font);         { set the font and point size }
                        TextSize(size);        { of text record (this is the }
                        GetFontInfo(f);        { hard part) }
                        te^^.lineHeight := f.ascent + f.descent + f.leading;
                        te^^.fontAscent := f.ascent;
                        te^^.txFont := font;
                        te^^.txSize := size;

                        OverhaulDisplay;
                        SetPort(savePort);
                    END;
            END;
    END;

{    Scroll the text in the window so that line lineNum is at the top.}
{    First line is line zero.}

    PROCEDURE setDWindowPos;

        VAR
            savePort : GrafPtr;

    BEGIN
        IF IsDWindow(theWind) THEN
            BEGIN
                GetPort(savePort);
                SyncGlobals(theWind);
                SetPort(dispWind);
                ScrollText(lineNum - GetCtlValue(dispScroll));
                SetPort(savePort);
            END;
    END;

{    Set display window activate notification procedure.}
{    Pass nil to disable it.}

    PROCEDURE SetDWindowNotify;

        VAR
            dInfo : DIHAndle;

    BEGIN
        IF theWind = NIL THEN            { reset window creation default }
            d_activate := p
        ELSE
            BEGIN
                dInfo := GetDInfo(theWind);
                IF dInfo <> NIL THEN
                    dInfo^^.dActivate := p;
            END;
    END;

{    Set display window autoflush characteristics}

    PROCEDURE SetDWindowFlush;

        VAR
            dInfo : DIHandle;

    BEGIN
        IF maxText > longint(32767) THEN
            maxText := 32767;
        IF maxText < d_loMaxText THEN
            maxText := d_loMaxText;
        IF flushAmt < d_loFlushAmt THEN
            flushAmt := d_loFlushAmt;
        IF theWind = NIL THEN
            BEGIN            { reset window creation defaults }
                d_maxText := maxText;
                d_flushAmt := flushAmt;
            END
        ELSE
            BEGIN
                dInfo := GetDInfo(theWind);
                IF dInfo <> NIL THEN
                    BEGIN
                        dInfo^^.dMaxText := maxText;
                        dInfo^^.dFlushAmt := flushAmt;
                    END;
            END;
    END;

{    Set which display window is to be used for output.  If theWind}
{    is nil, output is turned off.  If theWind is not a legal display}
{    window, nothing is done.}

    PROCEDURE SetDWindow;

    BEGIN
        IF (theWind = NIL) OR IsDWindow(theWind) THEN
            curDispWind := theWind;
    END;

{    Get the WindowPtr of the current output display window.  If}
{    output is turned off, this will be nil.}

    PROCEDURE GetDWindow;

    BEGIN
        theWind := curDispWind;
    END;

{    Flush text from the window and readjust the display.}

    PROCEDURE FlushDWindow;

    BEGIN
        IF IsDWindow(theWind) THEN
            BEGIN
                SyncGlobals(theWind);
                TESetSelect(longint(0), byteCount, dispTE);    { select text }
                TEDelete(dispTE);                                { clobber it }
                OverhaulDisplay;
            END;
    END;

{    Create and initialize a display window and the associated data}
{    structures, and return the window pointer.  Install window in}
{    list of display windows.}

    PROCEDURE SetupDWindow;

        VAR
            r : Rect;
            savePort : GrafPtr;
            dInfo : DIHandle;

    BEGIN
        GetPort(savePort);
        SkelWindow(dispWind, @Mouse, NIL, @Update, @Activate, NIL, @Clobber, NIL, false);
    { the window }
        { mouse click handler }
        { key clicks are ignored }
        { window updating procedure }
        { window activate/deactivate procedure }
        { TransSkel hides window if no close proc }
        { (generates deactivate event) }
        { window disposal procedure }
        { no idle proc }
        { irrelevant since no idle proc }

{    Build the scroll bar.  Make sure the borders overlap the}
{    window frame and the frame of the grow box.}

        CalcScrollRect(r);
        dispScroll := NewControl(dispWind, r, '', true, 0, 0, 0, scrollBarProc, longint(0));

{    Create the TE record used for text display.  Use defaults for}
{    display characteristics.  Setting window style overhauls}
{    display, so can cancel and update event pending for the window.}

        CalcEditRect(r);
        dispTE := TENew(r, r);

{    Get new information structure, attach to list of known display}
{    windows.}

        dInfo := DIHandle(NewHandle(sizeof(DisplayInfo)));

        dInfo^^.dNext := dwList;
        dwList := dInfo;
        dInfo^^.dWind := dispWind;
        dInfo^^.dScroll := dispScroll;
        dInfo^^.dTE := dispTE;

        SetDWindowNotify(dispWind, d_activate);
        SetDWindowFlush(dispWind, d_maxtext, d_flushAmt);
        SetDWindowStyle(dispWind, d_font, d_size, d_wrap, d_just);

{    Make window current display output window}

        SetDWindow(dispWind);
        SetPort(savePort);
    END;

{    Create and initialize a display window and the associated data}
{    structures, and return the window pointer.  Install window in}
{    list of display windows.  In single-window mode, disallow}
{    creation of a new window if one already exists.}

{    The parameters are similar to those for NewWindow.  See Inside}
{    Macintosh.}

    FUNCTION NewDWindow;

    BEGIN
        dispWind := NewWindow(NIL, bounds, title, visible, documentProc, behind, goAway, refCon);
        SetUpDWindow;
        NewDWindow := dispWind;
    END;

{    Create and initialize a display window (using a resource) and}
{    the associated data structures, and return the window pointer.}
{    Install window in list of display windows.  In single-window}
{    mode, disallow creation of a new window if one already exists.}

{    The parameters are similar to those for GetNewWindow.  See Inside}
{    Macintosh.}

    FUNCTION GetNewDWindow;

    BEGIN
        dispWind := GetNewWindow(resourceNum, NIL, behind);
        SetUPDWindow;
        GetNewDWindow := dispWind;
    END;

{ ------------------------------------------------------------ }
{                        Output Routines                            }
{ ------------------------------------------------------------ }


{}
{    Write text to display area if output is on (curDispWind != nil).}
{    DisplayText is the fundamental output routine.  All other}
{    output calls map (eventually) to it.}

{    First check whether the insertion will cause overflow and flush}
{    out some stuff if so.  Insert new text at the end, then test}
{    whether lines must be scrolled to get the new stuff to show up.}
{    If yes, then do the scroll.  Set values of scroll bar properly}
{    and highlight as appropriate.}

{    The current port is preserved.  Since all output calls end up}
{    here, it's the only output routine that has to save the port}
{    and check whether output is on.}

    PROCEDURE DisplayText;

        VAR
            nLines, dispLines, topLines, scrollLines, lHeight : integer;
        { number of lines in TERec }
        { number of lines displayable in window }
        { number of lines currently scrolled off top }
        { number of lines to scroll up }
            r : Rect;
            savePort : GrafPtr;
            dTE : TEHandle;

    BEGIN
        IF curDispWind <> NIL THEN
            BEGIN
                GetPort(savePort);
                SetPort(curDispWind);
                SyncGlobals(curDispWind);
                dTE := dispTE;

                IF dTE^^.teLength + len > dMaxText THEN    { check overflow }
                    BEGIN
                        FlushDWindow(dispWind, dFlushAmt);
                        DisplayString('(autoflush occurred)');
                    END;
                lHeight := dTE^^.lineHeight;
                TESetSelect(longint(32767), longint(32767), dTE);
                TEInsert(theText, len, dTE);
                r := dTE^^.viewRect;
                nLines := dTE^^.nLines;
                dispLines := (r.bottom - r.top) DIV lHeight;
                topLines := LinesOffTop;
                scrollLines := nLines - (topLines + dispLines);
                IF scrollLines > 0 THEN                                 { must scroll up }
                    TEScroll(0, -lHeight * scrollLines, dTE);            { scroll up }
                topLines := nLines - dispLines;
                IF (topLines >= 0) AND (GetCtlMax(dispScroll) <> topLines) THEN
                    BEGIN
                        SetCtlMax(dispScroll, topLines);
                        SetCtlValue(dispScroll, topLines);
                    END;
                HiliteScroll;
                SetPort(savePort);
            END;
    END;

{    Derived output routines:}

{    DisplayString    Write (Pascal) string}

{    DisplayLong        Write value of long integer}
{    DisplayInt        Write value of integer}
{    DisplayChar        Write character}

{    DisplayHexLong    Write value of long integer in hex (8 digits)}
{    DisplayHexInt    Write value of integer in hex (4 digits)}
{    DisplayHexChar    Write value of character in hex (2 digit)}

{    DisplayBoolean    Write boolean value}
{    DisplayLn        Write carriage return}

    PROCEDURE DisplayString;

        VAR
            myPtr : Ptr;

    BEGIN
        myPtr := Ptr(longint(@theStr) + 1);
        DisplayText(myPtr, longint(theStr[0]));
    END;

    PROCEDURE DisplayLong;

        VAR
            s : Str255;

    BEGIN
        NumToString(l, s);
        DisplayString(s);
    END;

    PROCEDURE DisplayInt;

    BEGIN
        DisplayLong(longint(i));
    END;

    PROCEDURE DisplayChar;

        VAR
            myPtr : Ptr;

    BEGIN
        myPtr := @c;
        myPtr := Ptr(longint(myPtr) + 1);
        DisplayText(myPtr, longint(1));
    END;

    PROCEDURE DisplayLn;

    BEGIN
        DisplayChar(char(13));
    END;

    PROCEDURE DisplayBoolean;

    BEGIN
        IF b THEN
            DisplayString('True')
        ELSE
            DisplayString('False');
    END;

    PROCEDURE HexByte (value : integer);    {value should be 0..15}
    BEGIN
        IF value < 10 THEN
            DisplayChar(char(value + integer('0')))
        ELSE
            DisplayChar(char(value + (integer('a') - 10)));
    END;

    PROCEDURE DisplayHexChar;

    BEGIN
        HexByte(integer(BitAnd(BitShift(longint(c), -4), $0000000f)));
        HexByte(integer(BitAnd(longint(c), $0000000f)));
    END;

    PROCEDURE DisplayHexInt;

    BEGIN
        DisplayHexChar(char(BitAnd(BitShift(longint(i), -8), $000000ff)));
        DisplayHexChar(char(BitAnd(longint(i), $000000ff)));
    END;

    PROCEDURE DisplayHexLong;

    BEGIN
        DisplayHexInt(Integer(BitAnd(BitShift(l, -16), $0000ffff)));
        DisplayHexInt(integer(BitAnd(l, $0000ffff)));
    END;

    PROCEDURE TransDisplayInit;

    BEGIN

{    Default values for display window characteristics}

        d_font := monaco;        { default font              }
        d_size := 9;                { default pointsize         }
        d_wrap := 0;                { default word wrap (on)    }
        d_just := teJustLeft;    { default justification     }
        d_maxText := 30000;    { default max text allowed  }
        d_flushAmt := 25000;    { default autoflush amount  }
        d_activate := NIL;        { default notification proc }

{    Lowest allowable values for autoflush characteristics}

        d_loMaxText := 100;
        d_loFlushAmt := 100;

{    dwList points to a list of structures describing the known display}
{    windows.}

{    curDispWind is the current output window.}
{    If curDispWind = nil, output is currently turned off.}

        dwList := NIL;
        dispWind := NIL;
        curDispWind := NIL;
    END;
END.